home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / FileUtil.tcl.z / FileUtil.tcl
Encoding:
Text File  |  1999-01-26  |  1.5 KB  |  93 lines
  1. # FileUtil.tcl ---
  2. #
  3. #
  4. #    Utility functions for filename handling.
  5. #
  6. # Copyright (c) 1996, Expert Interface Technologies
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11.  
  12. proc tixResolveDir {dir} {
  13.     set dir [tixFile tildesubst $dir]
  14.     set dir [tixFile trimslash $dir]
  15.     
  16.     if {$dir == "/"} {
  17.     return $dir
  18.     }
  19.  
  20.     if {[string index $dir 0] != "/"} {
  21.     # Isn't an absolute path
  22.     #
  23.     set appPWD [pwd]
  24.     catch {
  25.         cd $dir
  26.         set dir [pwd]
  27.     }
  28.     cd $appPWD
  29.     return $dir
  30.     }
  31.  
  32.     set names [split $dir "/"]
  33.  
  34.     # Get rid of all "."
  35.     set n /
  36.     foreach name [lrange $names 1 end] {
  37.     if {[string compare "." $name]} {
  38.         lappend n $name
  39.     }
  40.     }
  41.     if {$n == "/"} {
  42.     return /
  43.     }
  44.  
  45.     # Get rid of all ".."
  46.     #
  47.     set list [tixCompressDotDot $n 0]
  48.  
  49.     if {$list == "/"} {
  50.     return /
  51.     }
  52.  
  53.     # General case
  54.     #
  55.     set dir ""
  56.     foreach sub [lrange $list 1 end] {
  57.     append dir /$sub
  58.     }
  59.     return $dir
  60. }
  61.  
  62. proc tixCompressDotDot {list i} {
  63.     set done 0
  64.  
  65.     while {1} {
  66.     if {$i >= [llength $list]} {
  67.         return $list
  68.     }
  69.  
  70.     if {[lindex $list $i] != ".."} {
  71.         incr i
  72.         continue
  73.     }
  74.  
  75.     # We encounter a ".."
  76.     #
  77.     if {$i == 0} {
  78.         # Can't handle this
  79.         #
  80.         return ""
  81.     }
  82.     if {$i == 1} {
  83.         set l [lindex $list 0]
  84.         set list [concat $l [lrange $list 2 end]]
  85.         continue
  86.     }
  87.  
  88.     set l [lrange $list 0 [expr $i-2]]
  89.     set list [concat $l [lrange $list [expr $i+1] end]]
  90.     incr i -1
  91.     }
  92. }
  93.